home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / os2tools / lampdq / lampdq.e next >
Text File  |  1992-09-08  |  29KB  |  762 lines
  1. ; The following makes LAMPDQ.E separately compilable, so you can include the
  2. ; host functions in EPM even if not using the rest of LaMail.
  3.  
  4. ; Compilation logic:
  5. ;   If SMALL is defined, then we're being compiled into the base.
  6. ;   else, if INI_REPLY is defined, then we're being compiled into MAIL
  7. ;   otherwise, we're being compiled as a stand-alone routine that
  8. ;   can be linked in at run time.
  9.  
  10. const
  11. compile if not defined(SMALL)
  12.   tryinclude 'mycnf.e'                 -- Include user's configuration
  13.  
  14.  compile if not defined(HOST_SUPPORT)
  15.     HOST_SUPPORT = 'STD'
  16.  compile endif
  17.  compile if HOST_SUPPORT='STD'
  18.   compile if not defined(HOSTDRIVE)
  19.      HOSTDRIVE= 'H:'
  20.   compile endif
  21.  compile endif
  22. compile endif  -- not defined(SMALL)
  23. compile if not defined(RSCS)
  24.    RSCS = 'RSCS'
  25. compile endif
  26. compile if not defined(YKT_stuff)
  27. ; This determines whether the Yorktown-specific stuff is included
  28.    YKT_STUFF=0
  29. compile endif
  30. compile if not defined(CORE_stuff)
  31. ; This determines whether the CORE-specific stuff is included
  32.    CORE_STUFF=0
  33. compile endif
  34. compile if not defined(YKT_SERVICES)
  35. ; This determines whether the Yorktown-specific commands (CORE, PHONE, QLUNCH,
  36. ; etc.) are included in the macros and in the menus.
  37.    YKT_SERVICES=0
  38. compile endif
  39. compile if not defined(TILDE_CHAR)
  40.  compile if EVERSION < '5.21'
  41.    TILDE_CHAR = ''
  42.  compile else
  43.    TILDE_CHAR = '~'
  44.  compile endif
  45. compile endif
  46. compile if not defined(AUTO_LAMSERV)
  47. ; This determines whether LAMSERV should be started automatically
  48.    AUTO_LAMSERV = 0
  49. compile endif
  50.  
  51. compile if defined(SMALL) or not defined(INI_REPLY)  -- If in base or standalone
  52. definit
  53.    universal host_lt, defaultmenu, activemenu
  54.    universal host_printers
  55.  compile if defined(my_LT)
  56.    host_lt=my_LT           -- Used by LaMail.E; needed for E3EMUL if multiple LTs.
  57.  compile else
  58.    host_lt=''              -- Used by LaMail.E; needed for SLSRPI if multiple LTs.
  59.  compile endif
  60.  compile if defined(my_HOST_PRINTERS)
  61.    host_printers=my_HOST_PRINTERS  -- List of default host printers
  62.  compile else
  63.    host_printers=''
  64.  compile endif
  65.    deletemenu defaultmenu, 6, 0, 0  -- delete the existing Help menu (we want it to stay at the right)
  66.    call add_VM_cmds_to_menu(defaultmenu)  -- add the VM commands to the action bar
  67.    call add_help_menu(defaultmenu, dos_version()>=1020)  -- rebuild the help menu
  68.  compile if not defined(INI_REPLY)  -- If standalone; if in base, MAIN.E will do this.
  69.    if activemenu=defaultmenu then
  70.       showmenu activemenu  -- show the updated EPM menu
  71.    endif
  72.  compile endif
  73.  
  74. defproc add_VM_cmds_to_menu(menu)
  75.    buildsubmenu menu, 16, TILDE_CHAR'VM cmds', ''\1'Menus for invoking VM-related commands', 0 , 0
  76.      buildmenuitem menu, 16, 1600, 'output ~Inserted here...'\9'VMI',   'commandline VMI '\1'Execute a VM command, and have the output inserted into the current file',0,0
  77.      buildmenuitem menu, 16, 1601, 'output in ~New file...'\9'VMN',     'commandline VMN '\1'Execute a VM command, and see the output in a new file',0,0
  78.      buildmenuitem menu, 16, 1602, 'output in new ~window...'\9'VM',    'commandline VM '\1'Execute a VM command, and see the output in a new edit window',0,0
  79.      buildmenuitem menu, 16, 1620, '~Get a copy of host screen'\9'GETHOST', 'gethostd'\1'Insert a copy of the default host screen after the cursor line',0,0
  80.      buildmenuitem menu, 16, 1603, \0,                                '',      4, 0
  81.      buildmenuitem menu, 16, 1604, '~List host files...'\9'HLIST',    'hlistprompt'\1'Load a filelist of host files into an edit window',0,0
  82.      buildmenuitem menu, 16, 1605, \0,                                '',      4, 0
  83.      buildmenuitem menu, 16, 1606, '~Print current file on host...'\9'HOSTPRT', 'hostprt'\1'Print the current file on a host printer',0,0
  84.      buildmenuitem menu, 16, 1607, \0,                                '',      4, 0
  85.      buildmenuitem menu, 16, 1608, '~Query host for messages'\9'QMSG', 'qmsg'\1'Check to see if any new messages arrived since you started LAMSERV',0, 0
  86.  compile if YKT_SERVICES
  87.      buildmenuitem menu, 16, 1609, \0,                                '',      4, 0
  88.      buildmenuitem menu, 16, 1610, 'Look up p~hone number...'\9'PHONE', 'commandline Phone '\1'Invoke the Yorktown PHONE exec',0, 0
  89.      buildmenuitem menu, 16, 1611, 'Look up ~services...'\9'SERVICES',  'commandline Services '\1'Invoke the Yorktown SERVICES exec',0, 0
  90.      buildmenuitem menu, 16, 1612, \0,                                '',      4, 0
  91.      buildmenuitem menu, 16, 1613, 'See lunch ~menu'\9'QLUNCH',  'VM QLUNCH (NOCLEAR NOHILIGHT'\1'Invoke the Yorktown QLUNCH exec',0, 0
  92.      buildmenuitem menu, 16, 1614, 'See ~coffee cart schedule'\9'QCOFFEE',  'VM QCOFFEE NOCLEAR'\1'Invoke the Yorktown QCOFFEE exec',0, 0
  93. ;; CORE command is only defined if we're in MAIL.E
  94. ;;   buildmenuitem menu, 16, 1615, \0,                                '',      4, 0
  95. ;;   buildmenuitem menu, 16, 1616, 'Append CORE forum'\9'CORE',  'CORE',0, 0
  96.  compile endif
  97. compile endif
  98.  
  99. ;       Procedures for dealing with PDQ from within EPM.
  100. ;
  101. ; Adds the following commands:
  102. ;    VM:    Sends a command to the host; displays the result on the DOS screen.
  103. ;    VMI:   Sends a command to the host; inserts the result into the current file.
  104. ;    VMQ:   Sends a command to the host; throws away the result.
  105. ;    TELL:  Shorthand for VM TELL.
  106. ;    POLL:  Used to restart the poll loop if exited by Ctrl-break.
  107. ;    QMSG:  Queries the host for messages.  (Normally done by POLL)
  108.  
  109. ; Keys defined:
  110. ;    c_M is defined to pop-up the message window whenever a message is
  111. ;        received.  If no message has been received since the last time
  112. ;        the key was pressed, then it will display all previously received
  113. ;        messages (up to 40 lines).
  114.  
  115. ; 88/02/10  Added retry to hostconnect in case user quit PDQ on host, then
  116. ;           restarted it.  Fixed VMI in cases when RC <> 0.  Return RCs as
  117. ;           numbers if in range -32768 .. 32767; else as string x'12345678'.
  118.  
  119. ; 88/05/16  Modified for EOS2.  Uses LAMPDQ for host commands.
  120.  
  121. const
  122. /* SRPI dynalink functions basic constants */
  123.    SA_GET      = 1              /* downloading a file */
  124.    SA_EXEC     = 3              /* executing a command */
  125.  
  126. defc host
  127.    universal host_lt
  128.    parse value upcase(arg(1)) with arg1 rest
  129.    if arg1='?' then
  130.       sayerror 'Current host session is "'host_lt'".'
  131.    elseif arg(1)='' or (length(arg1)=1 & arg1>='A' & arg1<='Z') then
  132.       if not isoption(rest,'Q') then
  133.          sayerror 'Host session was "'host_lt'", now changed to "'arg1'".'
  134.       endif
  135.       host_lt = arg1
  136.    else
  137.       sayerror 'Invalid argument.  ? to query; blank or A-E to set.'
  138.    endif
  139.  
  140. defc TELL
  141.    'VME TELL' arg(1)
  142.  
  143. defc RQ
  144.    'VME RQUERY' arg(1)
  145.  
  146. defc VME
  147.    cmd_rc=sendhostcmdgetrslts(arg(1),hostrc,result)
  148.    if cmd_rc then
  149.       sayerror 'Error' cmd_rc 'trying to issue command.'
  150.       return rc
  151.    endif
  152.    if hostrc then
  153.       parse value upcase(arg(1)) with w1 w2 .
  154.       if w1='CP' | w1='EXEC' then w1=w1 w2; endif
  155.       sayerror w1 'error' hostrc': ' result
  156.    endif
  157.  
  158. defc PHONE
  159.    parse arg who
  160.    if who='' then
  161.       sayerror 'PHONE <name>  Looks up that person in the on-line directory.  PHONE ? for help.'
  162.       return
  163.    endif
  164.    'VMN PHONE' who
  165.    if rc=100 then sayerror 1; endif
  166.  
  167. defc HLIST                    ---- With features by TJR
  168.   if arg(1) = '' then
  169.       hfilespec = '* * A'
  170.   else
  171.       hfilespec = upcase(arg(1))
  172.   endif
  173.   sayerror 'Loading 'hfilespec' host files...'
  174.   'VMN LISTFILE' hfilespec '(HEADER DATE'
  175.   if not rc then
  176.      down; down
  177.      sayerror 'Move cursor to desired file and press Alt-1 to load it.'
  178.   endif
  179.  
  180. defc HLISTPROMPT
  181. compile if EVERSION >= '5.50'
  182.    display -8
  183. compile endif
  184.    sayerror 'Enter file specification.  E.g.,  * SCRIPT *  or  * XEDIT S.  Default is * * A'
  185. compile if EVERSION >= '5.50'
  186.    display 8
  187. compile endif
  188.    'commandline HLIST '
  189. compile if EVERSION < '5.50'
  190.    sayerror 0
  191. compile endif
  192.  
  193. compile if YKT_SERVICES
  194. defc SERVICES
  195.    'VMN SERVICES' arg(1)
  196.    if rc=100 then sayerror 1; endif
  197. compile endif
  198.  
  199. defc VM           -- Send command to VM & display output on DOS screen.
  200.    universal host_lt
  201.    if host_lt then hst='"host' host_lt '/Q" '; else hst=''; endif
  202.    'open' hst"'Postme VM_OPEN_CMD" arg(1)"'"
  203.  
  204. defc VM_OPEN_CMD      -- Passed by VM command as argument of a new session.
  205.    .autosave = 0
  206.    replaceline 'Processing host command' arg(1)
  207.    .filename = '.Output from' arg(1)
  208.    settitletext(.filename)
  209. ;; call showwindow('ON')
  210. ;; repaint_window()
  211.    size=.last
  212.    rc=vmi(arg(1),hostrc)
  213.    if rc then
  214.       msg = 'Error' rc 'attempting to issue host command.'
  215.       replaceline msg
  216.       sayerror msg
  217.    elseif size=.last then
  218.       if hostrc then replaceline '[Host cmd failed with RC' hostrc 'and no output.]'
  219.       else replaceline '[No output]'
  220.       endif
  221.    else
  222.       deleteline 1
  223.       .modify = 0
  224.       if hostrc<>0 then sayerror 'Host cmd failed with RC' hostrc; endif
  225.    endif
  226.    call windowsize1(min(.last+1,24),.windowwidth,0,0,1)  -- Size window to size of file
  227.  
  228. defc VMI          -- Send command to VM & insert output into current file.
  229.    size=.last
  230.    rc=vmi(arg(1),hostrc)
  231.    if rc then
  232.       sayerror 'Error' rc 'attempting to issue host command.'
  233.       return
  234.    endif
  235.    if size=.last then
  236.       if hostrc then sayerror 'Host cmd failed with RC' hostrc 'and no output.'
  237.       else sayerror '[No output]'
  238.       endif
  239.    else
  240.       insertline '.*----- Output from "'arg(1)'" -----',.line+1
  241.       insertline '.*----- [end, RC='hostrc'] -----',.line + .last - size + 1
  242.       if hostrc<>0 then sayerror 'Host cmd failed with RC' hostrc; endif
  243.    endif
  244.    rc=hostrc
  245.  
  246. defproc VMI(cmd,var host_rc)  -- Send command to VM & insert output into current file.
  247.    universal vTEMP_PATH
  248. compile if HOST_SUPPORT = 'SRPI'
  249.    universal hostrc
  250. compile endif
  251.  
  252. compile if HOST_SUPPORT = 'SRPI'
  253.    call issuehostcommand('',cmd)
  254. compile else
  255.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',cmd)
  256. compile endif
  257.    if rc then return rc; endif
  258. compile if HOST_SUPPORT = 'SRPI'
  259.    host_rc = hostrc
  260. compile else
  261.    'get' vTEMP_PATH'HOSTCMD.TMP'
  262.    getline host_rc,.line+1
  263.    deleteline .line+1
  264. compile endif
  265.  
  266. defc VMN       -- Send command to VM & insert output into a new file.
  267.    parse value upcase(arg(1)) with w1 w2 .
  268.    if w1='EXEC' | w1='CP' then w1=w2; endif
  269.    if w1='Q' then w1='QUERY'; endif    -- Assumes user didn't change default.
  270.    getfileid cmdfileid,w1 'OUTPUT'
  271.    if cmdfileid='' then
  272.       'E /n /q /c .tmp'
  273.       deleteline 1
  274.       .filename=w1 'OUTPUT'
  275.       oldmodify=0
  276.    else
  277.       activatefile cmdfileid
  278.       .last
  279.       oldmodify=.modify
  280.    endif
  281.    oldsize=.last
  282.    'VMI' arg(1)
  283.    hostrc=rc
  284.    .modify=oldmodify
  285.    if .last=0 then 'Q'
  286.    else
  287.       .cursory=1           -- Position so first new line is at top of screen.
  288.       oldsize+1
  289.    endif
  290.    rc=hostrc
  291.  
  292. defc VMQ     -- VM Quiet; send command and throw away output.
  293.    universal vTEMP_PATH
  294. compile if HOST_SUPPORT = 'SRPI'
  295.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1),'nul')
  296. compile else
  297.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1))
  298.    call erasetemp(vTEMP_PATH'HOSTCMD.TMP')
  299. compile endif
  300.  
  301. defc gethostd     -- Get a copy of the default host screen; uses the current default.
  302.    universal host_lt
  303.    'gethost' host_lt
  304.  
  305. defc hostprt          -- Print current edit file on host.
  306.    universal host_printers, host_lt
  307. compile if HOST_SUPPORT='EMUL' or HOST_SUPPORT='SRPI'
  308.    universal hostdrive
  309. compile endif
  310.    printer = 3
  311.    if host_printers then
  312.       printer=listbox('Select a host printer',' 'strip(host_printers),'/Print/Cancel/Select other/')
  313.       if printer='' then return; endif
  314.    endif
  315.    if printer=3 then
  316.       printer = entrybox('Enter name of host printer','/Print')
  317.    endif
  318.    if printer then
  319.       'save 'leftstr(hostdrive,1) || host_lt':lamail tmpprt a'
  320.       if rc then
  321.          sayerror 'Error' rc 'trying to save to host; print canceled.'
  322.          return
  323.       endif
  324.       stat=sendhostcommand('lamail files print PC2TEMP 'printer' lamail tmpprt a',hostrc)
  325.       sayerror 0
  326.       if stat then return hostcmderror(stat); endif
  327.       if hostrc then
  328.          sayerror 'Host returned error code' hostrc
  329.       endif
  330.    endif
  331.  
  332. defproc sendhostcommand(cmd,var hostrc)
  333. ;       Throw away results
  334.    return sendhostcmdgetrslts(cmd,hostrc,result)
  335. ;; ret =  sendhostcmdgetrslts(cmd,hostrc,result)            -- Alternative to above,
  336. ;; sayerror 'sendhostcmdgetrslts('cmd') returned "'ret'"'   -- for debugging
  337. ;; return ret
  338.  
  339. ; For SRPI and ECF, this routine gets the output into an E file, and the RC
  340. ; into the variable HOSTRC.
  341. ; For Send/Receive and CP78, the output comes via a disk file, and the RC is
  342. ; given on the first line.
  343. ; The differences are masked by COMPILE IFs in the callers.  (This routine
  344. ; is internal to this file.)
  345.  
  346. defproc issuehostcommand(pcfile, host_cmd)
  347. compile if HOST_SUPPORT = 'EMUL'         -- If using E3EMUL assume SEND/RECEIVE.
  348.    universal host_lt, hostdrive
  349.    universal hostcopy, hostcmd
  350.  compile if USING = 'IBM'
  351. ;; quietshell 'RECEIVE' pcfile host_LT':HOSTCMD ('host_cmd'>nul'
  352.    rc = EHLLAPI_RECEIVE(pcfile host_LT':HOSTCMD ('host_cmd)
  353.  compile elseif USING = 'CM'
  354.   compile if EVERSION >= 5
  355.    call send_HLLAPI_string('@CLAMPDQ HOSTCMD' host_cmd'@E')
  356.   compile else
  357.    if host_lt then
  358.       lt='/'host_lt' '
  359.    else
  360.       lt=''
  361.    endif
  362.    quietshell hostcmd lt'@CLAMPDQ HOSTCMD' host_cmd
  363.   compile endif
  364.    call dynalink('DOSCALLS', '#32', atol_swap(2000))  /* 2 second DOSSLEEP */
  365.    quietshell hostcopy  hostdrive||host_LT':HOSTCMD CMSUT1 * 'pcfile' /q /ascii'
  366.  compile endif
  367. compile elseif HOST_SUPPORT = 'STD'      -- If using SAVELOAD assume CP78.
  368.    quietshell 'CP78CMD LAMPDQ HOSTCMD' host_cmd'>nul'
  369.    quietshell 'CP78COPY H:HOSTCMD CMSUT1 *' pcfile '/q'
  370. compile elseif HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  371.    universal exec_server, file_server, hostrc, host_lt
  372.  
  373.    if arg(3) then queue_name=arg(3)\0
  374.    else queue_name = '\QUEUES\EXEQUEUE.000'\0
  375.    endif
  376.    f_s = leftstr(file_server || host_lt, 8)\0
  377.    e_s = leftstr(exec_server || host_lt, 8)\0
  378. compile if AUTO_LAMSERV
  379.    do i=1 to 2
  380. compile endif
  381.    command = host_cmd\0  -- Set inside loop, because after first call it's EBCDIC
  382.    /* call SRPI support for command */
  383.    request = offset(e_s)||selector(e_s)||
  384.              atoi(SA_EXEC)||
  385.              '0000000000'||             /* return codes */
  386.              offset(command)||selector(command)||
  387.              offset(queue_name)||selector(queue_name)||
  388.              offset(f_s)||selector(f_s)||
  389.              '0000'             -- Bytes 29-32 --> command return code
  390.    rc=0
  391.    result= dynalink('SRPILCC',
  392.                     'SERVEXEC',
  393.                     selector(request)||offset(request))
  394.    dynalink_RC = rc
  395.    if rc=sayerror('Dynalink: Unrecognized library name') then
  396.       if arg(3)='' then call cleanup(queue_name); endif
  397.       if arg(4) then
  398.          call poll('OFF')
  399.          sayerror 'SRPILCC.DLL not found; polling turned off.'
  400.          return '^'             -- Abort chk_msgs.
  401.       else
  402.          messageNwait('SRPILCC.DLL not found; host support can not be used.  Press a key.')
  403.          return dynalink_RC
  404.       endif
  405.    endif
  406.  
  407.    if result <> 0 then
  408. compile if AUTO_LAMSERV
  409.       if not arg(4) then  -- Don't bother if checking messages.
  410.          if sent_LAMSERV(result, request, i, host_LT) then
  411.             if arg(3)='' then call cleanup(queue_name); endif
  412.             iterate;
  413.          endif
  414.       endif
  415. compile endif
  416.       if arg(3)='' then call cleanup(queue_name); endif
  417.       if arg(4) & (result=2) & (ltoa(substr(request, 7, 4), 16)=1000402) then
  418.          return '^' -- No CMSSERV screen active.
  419.       endif
  420.       call show_error(result, request)
  421.       if arg(4) then return '^'; endif  -- Some other error.  Abort chk_msgs.
  422.       rc = result
  423.       return result
  424.    endif
  425. compile if AUTO_LAMSERV
  426.    leave
  427.    enddo
  428. compile endif
  429. /*
  430. temp = substr(request,29,4)
  431. sayerror 'temp=' temp
  432. sayerror 'after cleanup'
  433. display 1
  434. messageNwait('RC = "'temp'" =' asc(leftstr(temp,1)) asc(substr(temp,2,1)) asc(substr(temp,3,1)) asc(substr(temp,4,1)) )
  435. */
  436.    hostrc = ltoa(substr(request,29,4),10)
  437.    if arg(3)='' then  -- read output from the command and insert it in the file
  438.       if pcfile<>'' then 'xcom e /c' pcfile; deleteline 1; endif
  439.       call grabqueue(queue_name)
  440.    endif
  441.    rc = 0
  442. compile else
  443.    messageNwait('No host command support for' HOST_SUPPORT'. Press a key...')
  444.    stop
  445. compile endif
  446.  
  447. defproc gethostfile(pcfile, hostfile, bin)
  448.    universal host_lt
  449. compile if HOST_SUPPORT = 'EMUL'         -- If using E3EMUL assume SEND/RECEIVE.
  450.    universal hostcopy, hostdrive
  451.  compile if USING = 'IBM'
  452.    if bin='B' then opts=''; else opts='(ASCII CRLF'; endif
  453. ;; quietshell 'RECEIVE' pcfile host_LT':'hostfile opts'>nul'
  454.    rc = EHLLAPI_RECEIVE(pcfile host_LT':'hostfile opts)
  455.  compile elseif USING = 'CM'
  456.    if bin='B' then opts='/b'; else opts='/ASCII'; endif
  457.    quietshell hostcopy  hostdrive || host_LT':'hostfile pcfile' /q 'opts
  458.  compile endif
  459. compile elseif HOST_SUPPORT = 'STD'      -- If using SAVELOAD assume CP78.
  460.    if bin='B' then opts='/B'; else opts=''; endif
  461.    quietshell 'CP78COPY H:'hostfile pcfile opts '/q'
  462. compile elseif HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  463.    universal file_server, host_lt
  464.  
  465.    pc_name = pcfile\0
  466.    host_file = hostfile\0
  467. ;; if bin='B' then flag=0; else flag=1; endif    --> flag = bin<>'B'
  468.    f_s = leftstr(file_server || host_lt, 8)\0
  469.    /* building a request */
  470.    request = offset(f_s)||selector(f_s)||
  471.              atoi(SA_GET)||
  472.              '0000000000'||             /* return codes */
  473.              offset(host_file)||selector(host_file)||
  474.              offset(pc_name)||selector(pc_name)||
  475.              atoi(bin<>'B')
  476.  
  477.    /* calling the dynalink function */
  478.    rc = dynalink('SRPILCC',
  479.                  'SERVGET',
  480.                  selector(request)||offset(request))
  481.    if rc <> 0 then sayerror 'File transfer failed with RC' rc; endif
  482.    return rc
  483. compile else
  484.    messageNwait("Can't use host support" HOST_SUPPORT'. Press a key...')
  485.    stop
  486. compile endif
  487.  
  488. defproc sendhostcmdgetrslts(cmd,var host_rc,var result)
  489.    universal vTEMP_PATH
  490. compile if HOST_SUPPORT = 'SRPI'
  491.    universal hostrc
  492. compile endif
  493.    call issuehostcommand(vTEMP_PATH'HOSTCMD.TMP',arg(1))
  494.    if rc then /* sayerror 'Uh-oh:  RC =' rc; */ return rc; endif
  495. compile if HOST_SUPPORT = 'SRPI'
  496.    result=''
  497.    if arg(4) then              -- Flag to concatenate all lines
  498.       do i=1 to .last
  499.          result=result || textline(i) || \13
  500.          if length(result)=255 then leave; endif
  501.       enddo
  502.    elseif .last then getline result,1
  503.    endif
  504.    host_rc = hostrc              -- Set local parm to universal var. value
  505.    .modify = 0
  506. compile else
  507.    'xcom e /d /q' vTEMP_PATH'HOSTCMD.TMP'
  508.    getline host_rc,1
  509.    if .last=1 then
  510.       result=''
  511.    else
  512.       getline result,2
  513.    endif
  514.    call erasetemp(vTEMP_PATH'HOSTCMD.TMP')
  515. compile endif
  516.    'xcom q'
  517.    return 0
  518.  
  519. ;*****************     Stuff to support message polling follows:   **********
  520. ;  Also, add "Call Poll()" to MYMAIN.E
  521.  
  522.  
  523. defc qmsg    -- Query messages - if you don't want to wait for a time-out.
  524.    universal host_msg_file,msg_file_size
  525.    if host_msg_file <> '' then      -- Make sure it's still valid
  526.       getfileid fileid
  527.       display -2
  528.       rc = 0
  529.       activatefile host_msg_file
  530.       if rc then
  531.          host_msg_file = ''
  532.          msg_file_size = 0
  533.       else
  534.          activatefile fileid
  535.       endif
  536.       display 2
  537.    endif
  538.    if host_msg_file = '' then
  539.       'xcom e /n /q host_messages'
  540.       .titletext = 'Host messages'
  541.       getfileid host_msg_file
  542.       .autosave=0
  543.       deleteline 1
  544.    endif
  545.    status_=chkmsgs()
  546.    if host_msg_file.last=0 then
  547.       .modify = 0
  548.       'xcom q'
  549.       host_msg_file = ''
  550.    endif
  551.    if status_ then
  552.       activatefile host_msg_file
  553.       .cursory = 1
  554.       msg_file_size+1      -- Set .line to first new line.
  555.       msg_file_size = host_msg_file.last
  556.       if status_=1 then call pplay(1)
  557.       elseif status_=2 then call pplay(2)
  558.       elseif status_=3 then call pplay(3)
  559.       endif
  560.    else
  561.       sayerror 'No new messages.'
  562.    endif
  563.  
  564. defproc chkmsgs
  565.    universal msgflag, host_lt
  566.    universal host_msg_file
  567.    universal vTEMP_PATH
  568.    universal hostcopy, hostcmd
  569. compile if HOST_SUPPORT = 'SRPI'     -- If using SRPI then load directly.
  570.    universal hostrc, hostdrive
  571.    if '^' = issuehostcommand('','LAMSERV CHKMSGS','NUL',1)
  572.    then return 0       -- CMSSERV screen not active
  573.    endif
  574.    if hostrc <> 1 then return 0; endif  -- No messages
  575.    getfileid startfile
  576.    call loadfile(hostdrive || host_lt':LAMAIL MSGLOG A','/D /Q')
  577.    call issuehostcommand('','ERASE LAMAIL MSGLOG A','NUL',1)
  578. compile else
  579.  compile if HOST_SUPPORT = 'EMUL'
  580.    universal hostdrive
  581.  compile endif
  582.    string='12345678'  -- reserve 8 bytes.
  583.    call dynalink('VIOCALLS',        /* dynamic link library name          */
  584.                  'VIOGETCURTYPE',   /* Video Input Output GET CURsor TYPE */
  585.                  selector(string)|| /* string selector                    */
  586.                  offset(string)||   /* string offset                      */
  587.                  atoi(0))           /* Vio Handle                         */
  588.  compile if HOST_SUPPORT = 'EMUL'
  589.   compile if USING = 'IBM'
  590. ;; quietshell 'RECEIVE' vTEMP_PATH'MSGS.TMP 'host_LT':MSGS >nul'  -- This turns cursor back on.
  591.    rc = EHLLAPI_RECEIVE(vTEMP_PATH'MSGS.TMP 'host_LT':MSGS')      -- This turns cursor back on.
  592.   compile elseif USING = 'CM'
  593.    compile if EVERSION >= 5
  594.    call send_HLLAPI_string('@CLAMPDQ MSGS@E')
  595.    compile else
  596.    if host_lt then
  597.       lt='/'host_lt' '
  598.    else
  599.       lt=''
  600.    endif
  601.    quietshell hostcmd lt'@CLAMPDQ MSGS'
  602.    compile endif
  603.    call dynalink('DOSCALLS', '#32', atol_swap(2000))  /* 2 second DOSSLEEP */
  604.    quietshell hostcopy hostdrive || host_LT':MSGS CMSUT1 * 'vTEMP_PATH'MSGS.TMP /q /ascii'
  605.   compile endif
  606.  compile else
  607.    quietshell 'CP78CMD LAMPDQ MSGS>nul'
  608.    quietshell 'CP78COPY H:MSGS CMSUT1 *' vTEMP_PATH'MSGS.TMP /q'
  609.  compile endif
  610.    status_=rc
  611.    if substr(string,7,2)==atoi(-1) then
  612.       call cursoroff()  -- turn off cursor
  613.    endif
  614.    if status_ then sayerror '(CHKMSGS) Status =' status_; return 0; endif
  615.    'xcom e /d /q' vTEMP_PATH'MSGS.TMP'
  616. compile endif
  617.    msgflag=0                /* No messages seen yet. */
  618.    if textline(1)<>'' or .last>1 then  -- Some messages
  619.       do i=1 to .last
  620.          call parsehostmessage(textline(i))
  621.       end
  622.    endif
  623.    .modify = 0
  624.    'xcom q'
  625. compile if HOST_SUPPORT = 'SRPI'
  626.    activatefile startfile            -- Restore non-hidden ring.
  627. ;  display 1
  628. compile else                         -- If not using SRPI, erase temp file.
  629.    call erasetemp(vTEMP_PATH'MSGS.TMP')
  630. compile endif
  631.    return msgflag
  632.  
  633.  
  634. defproc ParseHostMessage(msgline)   /* Tailor for yourself. */
  635.    universal new_mail,msgflag
  636. ;  Values for MSGFLAG are:
  637. ;     0 - line not added
  638. ;     1 - line added, low priority (e.g. RSCS progress message)
  639. ;     2 - line added, normal priority (e.g., message from a real user)
  640. ;     3 - line added, high priority (e.g., message from director!)
  641.  
  642.    universal host_msg_file
  643.    lclmsgflag=2          /* Default:  Add line; normal priority. */
  644.    node=''; uid=''
  645.    parse value msgline with f id ':' rest
  646.    if upcase(f)='FROM' then                /* It's a message! */
  647.       uid=id
  648.       if id=RSCS then
  649.          parse value rest with w1 rest2
  650.          if leftstr(w1,5)='YKTVM' then rest=rest2 endif  -- Local YKT-ism
  651.          parse value rest with f id ':' rest2
  652.          if upcase(f)='FROM' then          /* Remote message */
  653.             if pos('(',id)>0 then  /*   from a user */
  654.                parse value id with node '(' uid ')'
  655.                msgline=rest
  656.             else                   /*   from another RSCS mschine */
  657.                node=id
  658.                msgline='From' node'('RSCS'):' rest2
  659.             endif
  660.          else
  661.             parse value upcase(rest) with w1 w2 w3 w4 w5 w6 w7 w8 w9 .
  662. ;  w1   w2     w3      w4 w5   w6 w7  w8    w9
  663. ;  File (5570) spooled to MYID -- ORG RNODE (RUSER)  2/03/88 17:00:32 EST
  664.             if w1='FILE' & w3='SPOOLED' & w4='TO' & w7='ORG' & leftstr(w9,1)='(' then
  665.                node=w8
  666.                parse value w9 with '(' uid ')'
  667.             endif
  668.          endif
  669.       endif
  670.       call setprior(uid,node,lclmsgflag,'MSG',rest)
  671.    else
  672.       lclmsgflag=1  -- CP response - give low priority, but display it.
  673.       parse value upcase(msgline) with w1 w2 w3 w4 w5 w6 w7 .
  674. ;        PUN FILE 3262 FROM IBMPC    COPY 001   NOHOLD
  675. ;        RDR FILE 3334 TRANSFERRED FROM USER RSCS
  676. ; Or, in XA,
  677. ;        RDR FILE 1234 SENT FROM IBMPC  PUN WAS 4321 RECS 0006 CPY 001 B NOHOLD NOKEEP
  678.       if w2='FILE' then
  679.          if w4='FROM' then uid=w5
  680.          elseif w4='TRANSFERRED' then uid=w7
  681.          elseif w4 w5='SENT FROM' then uid=w6
  682.          endif
  683.       endif
  684.       if uid<>'' then new_mail = 1; endif
  685.       call setprior(uid,node,lclmsgflag,'CP',msgline)
  686.    endif
  687.    if lclmsgflag then   /* Insert the line into the message file. */
  688.       insertline msgline,host_msg_file.last+1,host_msg_file
  689. ;  else  -- For debugging...
  690. ;     insertline '(?)' msgline,host_msg_file.last+1,host_msg_file
  691.    endif
  692.    msgflag=max(msgflag,lclmsgflag)
  693.  
  694.  
  695. ;*********** Priorities are set below:                  **********************
  696. defproc setprior(uid,node,var msgflag,how,text)
  697.      if uid=RSCS then     -- From some RSCS machine.  Ignore RSCS messages, but
  698.       if how='MSG' then                   -- not FILE TRANSFERRED FROM RSCS msg.
  699.          if pos('CPQ:',text) then         -- Something we asked RSCS?
  700.             msgflag=2                     -- If so, display it
  701.          else
  702.             msgflag=0                     -- otherwise, discard it.
  703.          endif
  704.       endif
  705. /*  My personal setup; not for product.
  706.    elseif ((uid='WALDBAU' | uid='SERENSO' | uid='CONNORS' |
  707.             uid='CONNELL' | uid='ARMSTRN') &
  708.            (node='' | leftstr(node,5)='YKTVM')) |
  709.           ((uid='RICH' | uid='RON') & (node='THORNVM'))
  710.       then msgflag=3
  711. */
  712.    endif
  713.  
  714. definit
  715.    universal host_msg_file,msg_file_size
  716.    getfileid fileid
  717.    msg_file_size = 0
  718.    host_msg_file = ''
  719.  
  720. ;******************* Following stuff adds the Speaker and Play support *****
  721.  
  722. defproc pplay(prior)
  723.    if     prior=1 then strng='3000 100 2400 100'
  724.    elseif prior=2 then strng='2000 100 2200 100 2400 150'
  725.    elseif prior=3 then strng='800 150 800 150 1000 150 1000 150 1600 180 800 150 900 150'
  726.    else strng=''
  727.    endif
  728.    do forever
  729.       parse value strng with pitch duration strng
  730.       if duration='' then leave; endif
  731.       call beep(pitch,duration)
  732.    end
  733. ;display 1; messageNwait('hostrc=' hostrc'; result="'result'"')
  734.  
  735. compile if EVERSION >= 5 & HOST_SUPPORT = 'EMUL'
  736. defproc send_HLLAPI_string(host_string)     -- Send a string to the  host screen
  737.    universal host_lt
  738.    lt = host_lt
  739.    if lt='' then lt='A'; endif
  740.    result=simple_HLLAPI_call(1, lt)  -- *** Connect to host PS ***
  741.    if result & result<>4 & result<>5 then  -- 4=Busy; 5=Locked
  742.       sayerror 'Error' result 'trying to connect to host session' lt
  743.       stop
  744.    endif
  745.    result=simple_HLLAPI_call(6, 'LaMail Interface Screen')  -- *** Search PS ***
  746.    if result=24 then
  747.       if 'Y' = askyesno('LAMPDQ appears to not be running.  Would you like it started?',1) then
  748.          result=simple_HLLAPI_call(3, '@CLAMPDQ@E')  -- *** Send key sequence to host ***
  749.          if result then
  750.             sayerror 'Error' result 'trying to send LAMPDQ command.'
  751.             stop
  752.          endif
  753.       endif
  754.    endif
  755.    result=simple_HLLAPI_call(3, host_string)  -- *** Send key sequence to host ***
  756.    if result then
  757.       sayerror 'Error' result 'trying to send host command.'
  758.       stop
  759.    endif
  760.    call simple_HLLAPI_call(2, '')  -- *** Disconnect from host presentation space ***
  761. compile endif
  762.